perm filename PLOUX.F4[PIC,LCS]2 blob
sn#085792 filedate 1974-02-05 generic text, type T, neo UTF8
SUBROUTINE READR(NWW)
COMMON /EDGEC/ A0,A1,A2,A3,A4,A5,A6,A7,
1 DEBUG,T(1),XP(1),YP(1),PARMAX,
1 HALF,FILE,RR,COH,RX,RY,CL,SL,D,B,FOUND
DIMENSION LIST5(0/1000),LIST(6,1000)
COMMON /LISTC/ LIST,LIST5,NEWEND,LO
COMMON/COMMAC/BCLIP,TCLIP,BITS,IWID,LINLEN,FLINE,LLINE,
1 LSIDE,RSIDE,DTA,HYSTAB(0/15)
DATA BITS/4/
INTEGER FLINE,RSIDE,HYSTAB,TIM1,TIM2,FILEN,FILE,BITS
READ(1) FILEN,RR,FLINE,LLINE,LSIDE,RSIDE,NEWEND,
1 ((LIST(I,N),I=1,6),N=1,NEWEND)
TYPE 202,NEWEND
IF(NEWEND.GE.1000)RETURN
DO 335 I=NEWEND*6+1,6000
335 LIST(I,1)=0
202 FORMAT(' NEWEND=',I4/)
END
SUBROUTINE PLOU(NWW)
COMMON/PLT/JX,JY,JPL,PLT,REV,RINV,ROT,RLR,RUD,CONST,E
1 ,JREV,JINV,KA,KB,KC,KD,RTO,JA,JB,JAR,JBR,A,IA,IB,IC,ID
C KA-D IS FOR INVIS. INNER AREA. IA-D IS FOR INVIS. OUTER AREA.
COMMON/DRW/JDRW(2000)/FU/FUJ(512),JJX,RDIV,ADML
EQUIVALENCE(JDRW,INP)
COMMON/DDP/IDP1(4000)
DIMENSION INP(10,200)
COMMON/MEDGE/MC,MD,RMC,MMD/CLR/KP,KQ,KR,KS,P
COMMON /LISTC/LIST(6,1000),LIST5(0/1000),NEWEND,LO
COMMON/COMMAC/BCLIP,TCLIP,BITS,IWID,LINLEN,FLINE,LLINE,
1 LSIDE,RSIDE,DTA,HYSTAB(1)
INTEGER FLINE,RSIDE
DATA NEWX/0/,NCNT/0/,JMC/1554/,JMD/1380/
IF(NEWEND.EQ.0)RETURN
IF(NEWEND)GO TO 6002
IF(NEWX)GO TO 1
RTO=6
CC LSIDE=6
CC RSIDE=265
CC FLINE=20
CC LLINE=250
NX=0
NY=0
1001 FORMAT(A1,3F)
1000 FORMAT(' D, P, S, M OR T HORZ.%,VRT.%, ROTATION'/)
6100 FORMAT(' INNER CLEAR AREA L-R-BT-TP% OUTER L-R-B-T%
1 REV=1, INV=1'/)
6001 FORMAT(14F)
1 CALL JZERO
JX=0
JY=0
CONST=0
TYPE 1000
ACCEPT 1001,WHICH,RLR,RUD,ROT
IF(WHICH.EQ.'R')RETURN
C TYPE 'R' TO GO BACK TO FILE TYPE-IN.
CC IF(NCNT.LT.20.AND.WHICH.NE.WX)NCNT=NCNT+1
NCNT=NCNT+1
REREAD 3,(INP(NA,NCNT),NA=1,10)
IF(WHICH.NE.'H')GO TO 8002
TYPE 9002
GO TO 1
9002 FORMAT(' D=DISPLAY, P=PLOT, S=SAVE FOR DRAWING PROG.'/
1 ' M=MOVE, T=TYPE MY INPUT BACK.'/)
8002 IF(WHICH.NE.'T')GO TO 3002
6002 TYPE 91,RDIV,JJX
91 FORMAT(' CENTR=',F6.2,' STEP=',I2)
DO 4002 K=1,NCNT
4002 TYPE 5002,(INP(NA,K),NA=1,10)
IF(NEWEND)RETURN
GO TO 1000
3002 IF(WHICH.EQ.'M')GO TO 3102
TYPE 6100
ACCEPT 6001,A,B,C,D,E,F,G,H,REV,RINV,P,Q,R,S
C TYPE -1 TO REPEAT LAST INPUT
IF(A.GE.0)GO TO 33
C REPEATS LAST INPUT
A=AA
B=BB
C=CC
D=DD
E=EE
F=FF
G=GG
H=HH
REV=RREV
RINV=RRINV
P=PP
Q=QQ
R=RR
S=SS
33 AA=A
BB=B
CC=C
DD=D
EE=E
FF=F
GG=G
HH=H
RREV=REV
RRINV=RINV
SS=S
PP=P
QQ=Q
RR=R
IF(NCNT.LT.20.AND.WHICH.NE.WX)NCNT=NCNT+1
REREAD 3,(INP(NA,NCNT),NA=1,10)
3102 JPL=3
WX=WHICH
C SO IT WON'T COUNT RETRIES.
3 FORMAT(10A5)
5002 FORMAT(1X10A5)
C FAC=SIZE BY 100'S, RLR=LEFT-RIGHT SIZE, RUD=UP-DOWN SIZE
C-- D 0 0 0,50,0,50 CLEARS LOWER LFT QUAD. 50 100 50 100 UPR RT.
C TYPE 'T' TO GET BACK ALL INPUT LINES.
IF(A+B+C+D.EQ.0)A=-1.
C 'N'= PLOT, BUT NO X
IF(WHICH.NE.'S')GO TO 7002
WHICH='P'
CONST=-1
7002 IF(WHICH.EQ.'M')GO TO 2002
IF(E+H+F+G.EQ.0)E=-1.
IF(P+Q+R+S.EQ.0)P=-1.
IF(RLR.EQ.0)RLR=100.
IF(RUD.EQ.0)RUD=100.
IF(ROT.EQ.1)RINV=RINV-1
2002 RLR=RLR/100.
RUD=RUD/100.
PLT=0
IF(WHICH.NE.'D')GO TO 1002
C DPY IS 1/3 SIZE OF PLOT.
GO TO 2000
1102 IF(WHICH.NE.'M')GO TO 1
C MOVE PEN, L-R%, U-D
2200 RX=JMC
RY=JMD
NX=RX*RLR
NY=RY*RUD
RLR=.01
RUD=.01
GO TO 67
1002 IF(WHICH.NE.'P')GO TO 1102
PLT=1
2000 IF(NEWEND.GT.1000) PAUSE 'NEWEND>1000'
67 MA=0
MB=0
MC=(RSIDE-LSIDE)*RTO*RLR+.5
MD=(LLINE-FLINE)*RTO*RUD+.5
JREV=MC/JPL
JINV=MD/JPL
JM=-380
KM=-200
IF(NEWX)GO TO 655
JMC=MC
JMD=MD
655 JQX=NX
JQY=NY
IF(WHICH.EQ.'M')GO TO 671
TYPE 657
657 FORMAT(' OUTER LIMITS')
TYPE 65,MA,MC,MB,MD
C OUTER COORDINATES
CC JREV=(JA+JC)/JPL
C JINV=(JB+JD)/JPL
KA=0
KB=0
KC=0
KD=0
KP=0
KQ=0
KR=0
KS=0
IA=-1
IB=99999
IC=-1
ID=99999
671 IF(NEWX.NE.-1)CALL DPYSET(1,IDP1,4000)
CALL SETPOG(1)
CALL TYPLOC(-300,-611)
CALL DPYBRT(6)
JX=NX/JPL
JY=NY/JPL
CALL AIVECT(-380,-200)
672 JA=0
JB=0
NC=MC/JPL
ND=MD/JPL
CALL DSTORT(JPL)
CALL LINES(3)
CC CALL JZERO
JA=NC
JB=0
CALL LINES(2)
JA=NC
JB=ND
CALL LINES(2)
JB=ND
JA=0
CALL LINES(2)
JA=0
JB=0
CALL LINES(2)
CALL DPYOUT(1)
IF(WHICH.NE.'M')GO TO 2683
168 NY=JQY
NX=JQX
GO TO 1
2683 NQ=0
IF(A)GO TO 1683
KA=MC*(A/100.)
KB=MC*(B/100.)
KC=MD*(C/100.)
KD=MD*(D/100.)
CALL INVIS(KA,KB,KC,KD,NQ)
1683 IF(P)GO TO 9683
KP=MC*(P/100.)
KQ=MC*(Q/100.)
KR=MD*(R/100.)
KS=MD*(S/100.)
CALL INVIS(KP,KQ,KR,KS,NQ)
9683 IF(E)GO TO 8683
IA=MC*(E/100.)
IB=MC*(F/100.)
IC=MD*(G/100.)
ID=MD*(H/100.)
CALL INVIS(IA,IB,IC,ID,NQ)
IF(PLT.EQ.0)E=-1
8683 IF(PLT.NE.0)JPL=1
KA=KA/JPL
KB=KB/JPL
KC=KC/JPL
KD=KD/JPL
KP=KP/JPL
KQ=KQ/JPL
KR=KR/JPL
KS=KS/JPL
IA=IA/JPL
IB=IB/JPL
IC=IC/JPL
ID=ID/JPL
TYPE 683
683 FORMAT(' OK?'/)
ACCEPT 1001,NA
IF(NA.EQ.'N')GO TO 168
JX=NX/JPL
JY=NY/JPL
IF(PLT.NE.0)GO TO 1681
6852 CALL CLRPOG(2)
CALL SETPOG(1)
CC JA=-380
CC JB=-200
CALL JZERO
CALL AIVECT(-380,-200)
GO TO 685
50 FORMAT(' DO YOU WANT THE FRAME ?'/)
1681 TYPE 50
65 FORMAT(' LFT=',I4,' RT=',I4,' BOT=',I4,' TOP=',I4)
ACCEPT 1001,ALFAB
CC2 IF(WHICH.EQ.'N')GO TO 681
IF(NEWX.NE.-1)CALL PLOTS(I)
681 PLT=-1
IF(ALFAB.NE.'Y') GOTO 685
JX=NX
JY=NY
JA=0
JB=0
CALL DSTORT(JPL)
CALL LINES(3)
JA=MC
JB=0
CALL LINES(2)
JA=MC
JB=MD
CALL LINES(2)
JA=0
JB=MD
CALL LINES(2)
JA=0
JB=0
CALL LINES(2)
685 JAR=0
JBR=0
JREV=MC/JPL
JINV=MD/JPL
IF(CONST)PLT=-2
CALL DSTORT(JPL)
CALL PLTMAN
NEWX=-1
NX=JQX
NY=JQY
WX=0
IF(PLT)CALL PLOT(0,0,3)
NEWEND=0
END